home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swaga_c.zip / CRT.SWG / 0009_Small CRT Replacement.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  157 lines
  1. Unit sCrt;
  2.  
  3. {
  4.  
  5.   by Trevor J Carlsen
  6.      PO Box 568
  7.      Port Hedland
  8.      Western Australia 6721
  9.      Phone -
  10.        Voice: 61 91 732026
  11.        Data : 61 91 732569
  12.  
  13.    This little Unit is intended to replace the Crt Unit in Programs that do
  14.    not require many of that Units Functions.  As a result the resulting .exe
  15.    code is much smaller.
  16.  
  17.    Released into the public domain 1989
  18.  
  19. }
  20.  
  21. Interface
  22.  
  23. Function KeyPressed: Boolean;
  24.   { Returns True if there is a keystroke waiting in the key buffer           }
  25.  
  26. Procedure ClrScr;
  27.   { Clears the screen and homes the cursor                                   }
  28.  
  29. Procedure ClrKey;
  30.   { Flushes the keystroke buffer                                             }
  31.  
  32. Function KeyWord : Word;
  33.     Inline  ($B4/$00/   {mov  ah,0}
  34.              $CD/$16);  {int  16h}
  35.   { Waits For a keypress and returns a Word containing the scancode and      }
  36.   { ascii code For the KeyPressed                                            }
  37.  
  38. Function ExtKey(Var k : Char; Var s : Byte): Boolean;
  39.   { Gets next keystroke from the keystroke buffer. if it was an Extended key }
  40.   { (ie. Function key etc.) returns True and k contains the scan code. if a  }
  41.   { normal key then returns False and k contains the Character and s the scan}
  42.   { code                                                                     }
  43.  
  44. Function ReadKey: Char;
  45.   { Gets next keystroke from the buffer. if Extended key returns #0          }
  46.  
  47. Function NextKey: Char;
  48.   { Flushes the keystroke buffer and then returns the next key as ReadKey    }
  49.  
  50. Function PeekKey: Char;
  51.   { Peeks at the next keypress in the buffer without removing it             }
  52.  
  53. Procedure Delay(s : Word);
  54.   { Machine independent Delay loop For s seconds                             }
  55.  
  56. Procedure GotoXY(x,y : Byte);
  57.   { Moves the cursor to X, y coordinates                                     }
  58.  
  59. { -------------------------------------------------------------------------- }
  60.  
  61. Implementation
  62.  
  63. Uses Dos;
  64.  
  65. Var
  66.   head : Word    Absolute $0040:$001A;
  67.   tail : Word    Absolute $0040:$001C;
  68.   time : LongInt Absolute $0040:$006C;
  69.   regs : Registers;
  70.  
  71. Function KeyPressed: Boolean;
  72.   begin
  73.     KeyPressed := (tail <> head);
  74.   end;
  75.  
  76. Procedure ClrScr;                                     { 25 line display only }
  77.  begin
  78.    Inline($B4/$06/$B0/$19/$B7/$07/$B5/$00/$B1/$00/$B6/$19/$B2/$4F/
  79.           $CD/$10/$B4/$02/$B7/$00/$B2/$00/$B6/$00/$CD/$10);
  80.  end;
  81.  
  82. Procedure ClrKey;
  83.   begin
  84.     head := tail;
  85.   end;
  86.  
  87.  
  88. Function ExtKey(Var k : Char; Var s : Byte): Boolean;
  89.  
  90.   Var
  91.     keycode : Word;
  92.     al      : Byte;
  93.     ah      : Byte;
  94.  
  95.   begin
  96.     ExtKey    := False;
  97.     Repeat
  98.       keycode := KeyWord;
  99.       al      := lo(keycode);
  100.       ah      := hi(keycode);
  101.       if al = 0 then begin
  102.         ExtKey := True;
  103.         al     := ah;
  104.       end;
  105.   Until al <> 0;
  106.   k := chr(al);
  107.   s := al;
  108. end;    {ExtKey}
  109.  
  110. Function ReadKey : Char;
  111.   Var
  112.     Key : Byte;
  113.   begin
  114.     Key := lo(KeyWord);
  115.     ReadKey := Char(Key);
  116.   end;
  117.  
  118. Function NextKey : Char;
  119.   begin
  120.     tail := head;
  121.     NextKey := ReadKey;
  122.   end;
  123.  
  124. Function PeekKey : Char;
  125.   begin
  126.     PeekKey := Char(Mem[$40:head]);
  127.   end;
  128.  
  129. Procedure Delay(s : Word);
  130.   Var
  131.     start    : LongInt;
  132.     finished : Boolean;
  133.   begin
  134.     start := time;
  135.     Repeat
  136.       if time < start then    { midnight rollover occurred during the period }
  137.         dec(start,$1800B0);
  138.       finished := (time > (start + s * 18.2));
  139.     Until finished;
  140.   end;
  141.  
  142. Procedure GotoXY(x,y : Byte);
  143.   begin
  144.     With regs do begin
  145.       ah := $02;
  146.       bh := 0;
  147.       dh := pred(y);
  148.       dl := pred(x);
  149.       intr($10,regs);
  150.     end; { With }
  151.   end;   { GotoXY }
  152.  
  153. end.
  154.  
  155.  
  156.  
  157.